home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 1 / Cream of the Crop 1.iso / COMM / PORTTEST.ARJ / LISTEN.PAS < prev    next >
Pascal/Delphi Source File  |  1991-09-16  |  5KB  |  169 lines

  1. {\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
  2. The contents of this file are not copyrighted.  Use it any way you want to.
  3.  
  4.         File : LISTEN.PAS
  5.         Type : Mainline
  6.     Language : TP6
  7.     Revision : 1.0
  8.       Author : Robert C. Henningsgard
  9.         Date : 091691
  10.  Description : COM port listener.
  11.  
  12.                Uses the Asynch Plus communications library
  13.                from Blaise Computing Inc, 2560 Ninth Street, Suite 316,
  14.                Berkeley, CA 94710 (415-540-5441).
  15.  
  16. \\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\}
  17. uses DOS,CRT,TURBOEXT,UNIT_A0,UNIT_A1;
  18.  
  19. const
  20.   ProgramName = 'LISTEN - RS-232C Port Monitor';
  21.   ProgramRevision = '1.0';
  22.   Copyright =
  23.     'Freeware - Committed to the public domain 1991 by Rob Henningsgard.';
  24.   TimeOutMs = 5000;
  25.  
  26. const
  27.   InQSize = 256;
  28.   OutQSize = 256;
  29.   BufferOverhead = 4;
  30.   MinPort = 1;
  31.   MaxPort = 4;
  32.  
  33. type
  34.   Buf = array[1..InQSize+OutQSize+BufferOverhead] of byte;
  35.   BufferArray = array[MinPort..MaxPort] of Buf;
  36.  
  37. var
  38.   CommunicationsInitialized : array[MinPort..MaxPort] of boolean;
  39.   InterCharacterDelay : array[MinPort..MaxPort] of integer;
  40.   Buffer : BufferArray;
  41.  
  42. function COMAddress(I : integer) : word;
  43. begin
  44.   if (I >= 1) and (I <= 4)
  45.     then COMAddress := memw[0:($400 + 2*pred(I))]
  46.     else COMAddress := 0;
  47. end;
  48.  
  49. procedure Async_Send(PortNumber : word;C : char);
  50. var
  51.   W : word;
  52. begin
  53.   W := __WrtChA1(PortNumber,C);
  54. end; { Async_Send }
  55.  
  56. function AsyncReceive(PortNumber : word;var C : char) : boolean;
  57. var
  58.   W,InQSize,PortStatus : word;
  59. begin
  60.   W := __RdChA1(PortNumber,C,InQSize,PortStatus);
  61.   AsyncReceive := (W = 0);
  62. end; { AsyncReceive}
  63.  
  64. procedure Finish_Communications(PortNumber : word);
  65. {
  66. Close port and drop DTR
  67. }
  68. var
  69.   W : word;
  70. begin { Finish_Communications }
  71.   if CommunicationsInitialized[PortNumber] then begin
  72.     W := __CloseA1(PortNumber);
  73.     CommunicationsInitialized[PortNumber] := false;
  74.   end;
  75. end; { Finish_Communications }
  76.  
  77. function InitCommunications(PortNumber,BaudRate,Delay : integer) : boolean;
  78. const
  79.   IntLevel = 0;
  80.   PortAds = 0;
  81.   NoParity = 0;
  82.   EightDataBits = 3;
  83.   OneStopBit = 0;
  84.   NoXONXOFF = 0;
  85.   NoBit7Trimming = 0;
  86.   NoBit7Forcing = 0;
  87.   DoNotRequireCTS = 0;
  88.  
  89. var
  90.   W : word;
  91.   BaudVar : integer;
  92. begin { InitCommunications }
  93.   InitCommunications := false;
  94.   if (BaudRate mod 150 <> 0) then exit; { illegal }
  95.   BaudVar := 8;
  96.   while (BaudRate < 19200) do begin { set up Asynch Plus baud number   }
  97.     BaudRate := BaudRate * 2;       { where 8=19200, 7=9600, 6=4800... }
  98.     dec(BaudVar);
  99.   end;
  100.   if (PortNumber in[MinPort..MaxPort]) and __LCOMOKA1 then begin
  101.     if (__OpenA1(PortNumber,InQSize,OutQSize,IntLevel,
  102.                  PortAds,@Buffer[PortNumber]) <> 0) then exit;
  103.     if (__SetOpA1(PortNumber,1,BaudVar) <> 0) then exit;
  104.     if (__SetOpA1(PortNumber,2,NoParity) <> 0) then exit;
  105.     if (__SetOpA1(PortNumber,3,EightDataBits) <> 0) then exit;
  106.     if (__SetOpA1(PortNumber,4,OneStopBit) <> 0) then exit;
  107.     if (__SetOpA1(PortNumber,5,NoXONXOFF) <> 0) then exit;
  108.     if (__SetOpA1(PortNumber,6,NoXONXOFF) <> 0) then exit;
  109.     if (__SetOpA1(PortNumber,9,DoNotRequireCTS) <> 0) then exit;
  110.     InitCommunications := true;
  111.     InterCharacterDelay[PortNumber] := Delay;
  112.     CommunicationsInitialized[PortNumber] := true;
  113.   end;
  114. end; { InitCommunications }
  115.  
  116. var
  117.   I : integer;
  118.   Port,Baud : integer;
  119.   S : string;
  120.   C : char;
  121.  
  122. begin { Listen }
  123.   checkbreak := false;
  124.   writeln(ProgramName,' Rev ',ProgramRevision);
  125.   writeln(Copyright);
  126.   writeln;
  127.   if (paramcount < 2) then begin
  128.     writeln('LISTEN  PORT  BAUD');
  129.     writeln('        |     |');
  130.     writeln('        |     +-- the baud rate to listen at');
  131.     writeln('        +-- the port number to listen to');
  132.     halt;
  133.   end;
  134.   S := paramstr(1);
  135.   val(S,Port,I);
  136.   S := paramstr(2);
  137.   val(S,Baud,I);
  138.   if not ((Port > 0) and (Port < 4)) then begin
  139.     writeln('Illegal Port number ',Port,'.  Must be in the range 1..4.');
  140.     halt;
  141.   end;
  142.   if (COMAddress(Port) = 0) then begin
  143.     writeln('There is no COM',Port,' installed in this machine.');
  144.     halt;
  145.   end;
  146.   if not ((Baud > 74) and (Baud < 19201)) then begin
  147.     writeln('Illegal Baud rate ',Baud,'.  Must be in the range 75..19200.');
  148.     halt;
  149.   end;
  150.   clrscr;
  151.   writeln(ProgramName,' Rev ',ProgramRevision);
  152.   writeln(Copyright);
  153.   writeln;
  154.   writeln('Listening to port ',Port,' at ',Baud,' baud.  Press any key to quit.');
  155.   window(1,6,80,22);
  156.   clrscr;
  157.   for I := MinPort to MaxPort do CommunicationsInitialized[I] := false;
  158.   if not InitCommunications(Port,Baud,0) then begin
  159.     writeln('Unable to initialize the port.');
  160.     halt;
  161.   end;
  162.   while not keypressed do if AsyncReceive(Port,C) then write(C);
  163.   while keypressed do C := readkey;
  164.   Finish_Communications(Port);
  165.   window(1,1,80,24);
  166.   gotoxy(1,23);
  167.   writeln(ProgramName,' ended.');
  168. end. { Listen }
  169.